R Notebook

Kids Hobby Prediction Dataset

Problem

Children often find themselves at a crossroads when it comes to discovering their passions or hobbies, be it in academics, arts, or sports. Recognizing the importance of guiding children towards activities they are passionate about; we have curated a dataset obtained through surveys conducted with parents. This dataset compiles valuable information about children’s preferences, enabling the creation of a classification model aimed at predicting kids’ hobbies.

In this exploratory journey, we delve into the dataset to uncover patterns and insights that can assist parents in understanding their child’s inclinations better. Through the application of clustering techniques, we aim to categorize children based on number of columns (Fav_sub , Scholarship, etc..). The ultimate goal is to provide parents with meaningful recommendations, fostering an environment where children can thrive in activities that genuinely resonate with their interests.

By analyzing this dataset, we hope to offer insightful information that will aid parents in guiding their kids toward the right hobbies.

Data Mining Task

The data mining task at hand revolves around predicting kids’ hobbies based on a dataset named “Hobby_Data,” obtained through specific questions posed to their parents regarding preferences, capabilities, and achievements. This dataset serves as the foundation for two primary data mining tasks: classification and clustering. In the classification process, the goal is to train a machine learning model to be capable of accurately predicting a child’s hobby as either “academic,” “art,” or “sports.” This requires using the data collected from parents to establish patterns and relationships that guide the model in making accurate predictions. Concurrently, the clustering process involves partitioning the dataset into meaningful clusters, grouping together children with similar characteristics or preferences. Through these dual approaches, the data mining task aims to develop a robust predictive model capable of accurately categorizing children’s hobbies in order to uncover the inherent structures, patterns, and associations within the dataset, contributing to a deeper understanding of the diverse interests and engagement levels of the young population in academic, artistic, and sports-related activities.

Data

The source: https://www.kaggle.com/datasets/abtabm/hobby-prediction-basic Number of objects: 1601

Number of attributes: 14

Description: Following the selection of our data set (“Hobby_Data”) which predicts kids’ hobbies, that was collected by asking their parents specific questions about their kid’s preferences, capabilities, and achievements. To help us train the machine to predict the kid’s hobby. We will begin to preprocess and analyze the data.

Attribute Description:

Attribute name	Description	Data type
Olympiad_Participation	Has your child participated in any Science/Maths	Boolean
Scholarship	Has he/she received any scholarship?	Boolean
School	Love’s going to school?	Boolean
Fav_sub	What is his/her favorite subject?	Categorical
Projects	Has done any projects under academics before?	Boolean
Grasp_pow	His/Her Grasping power (1-6)	Ordinal
Time_sprt	How much time does he/she spend playing outdoor/indoor games?	Ordinal
Medals	Medals won in Sports?	Boolean
Career_sprt	Want’s to pursue his/her career in sports?	Boolean
Act_sprt	Regular in his/her sports activities?	Boolean
Fant_arts	Love creating fantasy paintings?	Boolean
Won_arts	Won art competitions?	Ordinal
Time_art	Time utilized in Arts?	Ordinal
Predicted Hobby	predictions for the hobby that the kid wouldl ike	Categorical

======= >>>>>>> Stashed changes

General information about the data set:

str(Hobby_Data)

• samples of raw dataset:

sample(Hobby_Data)

• variables distribution:

  In our dataset, numeric variables are not available; instead, we have three ordinal variables. Due to the nature of our data types, certain types of graphs, such as scatter plots and box plots, were not suitable for our analysis.

variables distribution of Time_sprt:

install.packages("magrittr") # install only one time then put this command as comment after installation
library(magrittr) ## for pipe operations
Hobby_Data$Time_art %>% density() %>% plot(main='variables distribution of Time_art')

In the “Time_art” variable, parents were requested to assess the time their child dedicated to artistic pursuits like painting or paper crafting, using a scale ranging from 1 to 6, where 6 represents the highest level of involvement. It’s worth noting that the concentration of lower ratings at the lower end of the scale (1) is quite pronounced, and this tendency may be attributed to the inherent inclination of children towards physical activities.

variables distribution of Time_art:

Hobby_Data$Time_sprt %>% density() %>% plot(main='variables distribution of Time_sprt')

Parents were requested to assess their children’s involvement in sports on a scale from 1 to 6 within the “Time_sprt” variable. Notably, the most prevalent ranking was 3, suggesting a moderate level of sports participation. It’s interesting to observe that the distribution exhibits a shape akin to a bell curve, indicating that a substantial proportion of children have a genuine love for sports.

variables distribution of Grasp_pow:

Hobby_Data$Grasp_pow %>% density() %>% plot(main='variables distribution of Grasp_pow')

The density graph depicting parents’ ratings of their children’s grasp power, which ranges from 1 to 6, illustrates a trend where the most common rating is level 3, followed by level 4, level 5, level 2, level 1, and level 6. This distribution indicates that a substantial proportion of parents believe their children possess grasp power that is average or slightly above average (levels 3 and 4), with fewer children rated at the extremes (levels 1, 2, 5, and 6).

variables distribution of the class label ‘Predicted Hobby’:

install.packages("dplyr") # install only one time then put this command as comment after installation
library(dplyr)

dataset2 <- Hobby_Data %>% sample_n(1600)
table(dataset2$`Predicted Hobby`) %>% pie()
tab <- dataset2$`Predicted Hobby` %>% table()
precentages <- tab %>% prop.table() %>% round(3) * 100 
txt <- paste0(names(tab), '\n', precentages, '%')
pie(tab, labels=txt)

The pie chart illustrates the distribution of the class label ‘Predicted Hobby’. It’s evident that a substantial portion, approximately 43.7%, of the children’s hobbies are academic in nature, indicating a strong interest in educational pursuits. Additionally, 30.8% of the kids are engaged in sports, reflecting a significant inclination towards physical activities. Arts-related hobbies account for 25.6% of the total, the distribution reflects a harmonious blend of hobbies. This balanced distribution not only signifies a variety of interests but also indicates a well-rounded engagement of children in academic, physical, and creative activities.

Statistical measures :

find_mode <- function(x) {
  u <- unique(x)
  tab <- tabulate(match(x, u))
  u[tab == max(tab)]
}

find_mode(Hobby_Data$Time_art)
# Updated upstream
hist(Hobby_Data$Time_art)

#Stashed changes

The histogram makes it evident that the mode is equal to 1, and we believe that the high frequency of parents ranking “1” as the most chosen rank in the “Time_art” variable could be attributed to several factors. It might indicate that a significant number of parents perceive their children’s involvement in art activities as relatively low, possibly due to time constraints, academic priorities, or a limited interest in art. Alternatively, it could reflect that parents value a more balanced approach to their children’s activities, with a variety of interests and responsibilities sharing their time. This trend could also result from a cultural or educational emphasis on other subjects and extracurricular activities that compete for a child’s time, potentially leading to a lower ranking for art-related activities.

find_mode(Hobby_Data$Grasp_pow)
hist(Hobby_Data$Grasp_pow)

Rank 3, in this context, may have been the most chosen rank because it likely represents an average or moderate level of grasp power. Parents may have assessed their children’s grasp power as neither exceptionally strong (rank 5 or 6) nor particularly weak (rank 1 or 2), resulting in the preference for the middle-ranking option. This choice could reflect a perception that their children’s grasp power falls within a typical or expected range, making it the most common rating.

find_mode(Hobby_Data$Time_sprt)
hist(Hobby_Data$Time_sprt)

As shown in the histogram the rank 3 on a scale of 1 to 6 was likely the most chosen rank for assessing children’s involvement in sports because it represents a balanced middle ground. Parents may have perceived rank 3 as indicating that their children are moderately involved in sports, not excessively committed or disinterested. This middle-of-the-road ranking reflects a common perspective that many parents may hold, considering that extreme rankings, such as 1 or 6, might suggest either a lack of involvement or an excessive focus on sports, which may not align with their perception of their child’s overall well-rounded development.

The histogram graph for “Time_art” variable

hist(Hobby_Data$Time_art)

The histogram makes it evident that the mode is equal to 1, and we believe that the high frequency of parents ranking “1” as the most chosen rank in the “Time_art” variable could be attributed to several factors. It might indicate that a significant number of parents perceive their children’s involvement in art activities as relatively low, possibly due to time constraints, academic priorities, or a limited interest in art. Alternatively, it could reflect that parents value a more balanced approach to their children’s activities, with a variety of interests and responsibilities sharing their time. This trend could also result from a cultural or educational emphasis on other subjects and extracurricular activities that compete for a child’s time, potentially leading to a lower ranking for art-related activities.

find_mode(Hobby_Data$Grasp_pow)

The histogram graph for “Grasp_pow” variable

hist(Hobby_Data$Grasp_pow)

Rank 3, in this context, may have been the most chosen rank because it likely represents an average or moderate level of grasp power. Parents may have assessed their children’s grasp power as neither exceptionally strong (rank 5 or 6) nor particularly weak (rank 1 or 2), resulting in the preference for the middle-ranking option. This choice could reflect a perception that their children’s grasp power falls within a typical or expected range, making it the most common rating.

find_mode(Hobby_Data$Time_sprt)

The histogram graph for “Time_sprt” variable

hist(Hobby_Data$Time_sprt)

As shown in the histogram the rank 3 on a scale of 1 to 6 was likely the most chosen rank for assessing children’s involvement in sports because it represents a balanced middle ground. Parents may have perceived rank 3 as indicating that their children are moderately involved in sports, not excessively committed or disinterested. This middle-of-the-road ranking reflects a common perspective that many parents may hold, considering that extreme rankings, such as 1 or 6, might suggest either a lack of involvement or an excessive focus on sports, which may not align with their perception of their child’s overall well-rounded development.

Data preprocessing

#1# Data cleaning:

During the data cleaning stage, finding and fixing faults, inconsistencies, and errors in a dataset helps it be more reliable and of higher quality for analysis and modeling. There are methods for handling missing values, detecting outliers, resolving inconsistencies, and standardizing formats.

import Dataset”Hobby_Data”

View(Hobby_Data)

str(Hobby_Data)

check missing value :

is.na(Hobby_Data)

find the total null values in the dataset:

sum(is.na(Hobby_Data))

Description:

This stage involves checking and deleting for null and missing values because they might have a significant impact on the data and cause errors and negative effects in subsequent steps.We simply looked for missing values, and there are a missing values in our dataset. According to our investigation, the dataset does not contain any outliers since it doesn’t have a numerical data type. Additionally, there are no inconsistent values or other errors.

Dataset after cleaning step:

sample(Hobby_Data)

#2#Encoding: This step includes a Converting categorical or non-numeric data into a numerical format, which is necessary for compatibility with subsequent steps in preprocessing.

Hobby_Data$Olympiad_Participation = factor(Hobby_Data$Olympiad_Participation,levels = c("No", "Yes"), labels = c(0, 1))
Hobby_Data$Scholarship = factor(Hobby_Data$Scholarship , levels = c("No", "Yes"), labels = c(0, 1))
Hobby_Data$School = factor(Hobby_Data$School, levels = c("No", "Yes"), labels = c(0, 1))
Hobby_Data$Projects = factor(Hobby_Data$Projects, levels = c("No", "Yes"), labels = c(0, 1))
Hobby_Data$Medals = factor(Hobby_Data$Medals, levels = c("No", "Yes"), labels = c(0, 1))
Hobby_Data$Career_sprt = factor(Hobby_Data$Career_sprt, levels = c("No", "Yes"), labels = c(0, 1))
Hobby_Data$Act_sprt = factor(Hobby_Data$Act_sprt, levels = c("No", "Yes"), labels = c(0, 1))
Hobby_Data$Fant_arts = factor(Hobby_Data$Fant_arts, levels = c("No", "Yes"), labels = c(0, 1))
Hobby_Data$Won_arts = factor(Hobby_Data$Won_arts, levels = c("No", "Maybe", "Yes"), labels = c(0, 2, 1))
Hobby_Data$Fav_sub = factor(Hobby_Data$Fav_sub, levels = c("Science", "Mathematics", "History/Geography", "Any language"), labels = c(1, 2, 3, 4))
Hobby_Data$`Predicted Hobby` <- factor(Hobby_Data$`Predicted Hobby`, levels = c("Academics", "Arts", "Sports"), labels = c(1, 2, 3))

Dataset after Encoding :

sample(Hobby_Data)

#3# Normalization and Discetization:

We don’t need to use normalization and discetization in our dataset. Since our dataset doesn’t have numeric attributes and normalization involves mathematical operations, which can result in meaningless values and errors, Also, applying discretization leads to a loss of information and creates intervals and relationships that don’t exist between values.

#4#Feature Selection:

To improve the accuracy of our predictions for the target class “Predicted Hobby” and decrease the processing time of our classifier, we will utilize feature selection techniques. These techniques enable us to eliminate redundant or irrelevant attributes from the dataset, resulting in a more concise subset of features that provide the most valuable information for our predictions.

Specifically, we will use two feature selection methods: Rank Features by Importance and Feature Selection Using Recursive Feature Elimination (RFE).

1.Rank Features by Importance:

This method used in the code helps us determine which features are most important for predicting the “Predicted Hobby” class label in the dataset. It utilizes the Random Forest algorithm, known for its accurate prediction capabilities. This method calculates the importance of each feature by assessing its contribution to the overall accuracy of the predictions. By ranking the features based on their importance, we can identify the ones that have the greatest influence on determining hobbies.

Ensure the results are repeatable by setting a seed:

set.seed(7)

Load the necessary libraries:

install.packages("caret")
install.packages("randomForest")
library(caret)
library(randomForest)

Separate the predictors and the class label:

predictors <- Hobby_Data[, -14]  # Excluding the class label (Predicted Hobby)
class_label <- Hobby_Data$`Predicted Hobby`

Train a Random Forest model:

model <- randomForest(predictors, class_label, importance = TRUE)

Get the variable importance:

importance <- importance(model)

Rank the features by importance:

ranked_features <- sort(importance[, "MeanDecreaseGini"], decreasing = TRUE)

Print the ranked features:

print(ranked_features)

barplot(ranked_features, horiz = TRUE, las = 1, main = "Kids Hobby Variable Importance Ranking")

2.Feature Selection Using RFE:

The Recursive Feature Elimination (RFE) method with Random Forest is a technique used to select the most important features for accurate predictions . It iteratively eliminates less relevant features, retraining the model at each step to evaluate performance. By focusing on the most informative features, RFE improves reduces complexity, and enhances prediction accuracy. It is particularly effective with Random Forest due to its ability to handle complex relationships and high-dimensional data. RFE helps identify the most important attributes associated with the target variable, enabling the creation of more efficient and accurate models.

Ensure the results are repeatable by setting a seed:

set.seed(7)

Load the necessary libraries:

library(caret)

Define the control parameters for RFE using random forest selection function:

control <- rfeControl(functions = rfFuncs, method = "cv", number = 10)

Extract the predictor variables from Hobby_Data:

predictors <- Hobby_Data[, -ncol(Hobby_Data)]

Convert the outcome variable to a factor:

outcome <- as.factor(Hobby_Data$`Predicted Hobby`)

Run the RFE algorithm:

results <- rfe(predictors, outcome, sizes = 1:ncol(Hobby_Data), rfeControl = control)

Summarize the results:

print(results)

List the chosen features selected by RFE:

predictors(results)

Plot the results:

plot(results, type = c("g", "o"))

3.Removing Irrelevant Columns:

By considering both Recursive Feature Elimination (RFE) and Rank By Importance, we can make informed decisions about feature relevance and impact on the model. In this case, the columns “School,” “Medals” should be deleted as they have lower importance scores compared to the selected variables. Removing these columns simplifies the model and reduces dimensionality, eliminating potential noise and irrelevant information that could hinder accurate predictions.

Remove the specified columns from the Hobby_Kids dataset:

Hobby_Data <- Hobby_Data[, !(colnames(Hobby_Data) %in% c("School", "Medals"))]

Display the updated dataset after deleting columns:

sample(Hobby_Data)

we can see that the two columns are deleted(“School”, “Medals”).

Balanced Data

# Calculate class imbalance
class_imbalance <- max(prop.table(table(Hobby_Data$`Predicted Hobby`))) - min(prop.table(table(Hobby_Data$`Predicted Hobby`)))

# Print the result
print(class_imbalance)

if class_imbalance is close to 0, it suggests that the proportions of different classes are relatively similar, indicating a balanced dataset. Conversely, if class_imbalance is larger, it suggests a more significant imbalance between the classes. The calculated class imbalance value of 0.1805122 suggests that the distribution of classes in the “Predicted_Hobby” column of the dataset is relatively balanced. The class imbalance is a measure of the difference between the proportions of the most prevalent and least prevalent classes. In this case, the value is close to 0, indicating that there is a minimal difference between the proportions of different classes. A lower-class imbalance value is generally desirable, as it signifies a more even distribution of instances across classes, which can be beneficial for the training and performance of machine learning models.

Data Mining Technique

Evaluation And Comparison

————————————————— Classification—————————————————-

After preprocessing, we will proceed to the classification step. In this phase, as part of supervised learning, we will apply a classification algorithm to assign each data point into predefined categories based on its attributes. This involves selecting the most relevant features that have been cleaned and formatted during preprocessing. The selected model will then learn from training data, enabling it to predict the category of new, unseen data accurately. This step is essential for making informed decisions or predictions based on the data.

We implement a decision tree on the dataset, which has been partitioned into Training and Test sets using the percentage split method. This method ensures that each subset is a randomized, representative sample of the entire dataset, thus minimizing bias and enabling consistent model performance evaluation. We choose three different split sizes: (“90%”, “10%”), (“80%”, “20%”), and (“70%”, “30%”). These varying sizes are selected to provide insight into the model’s performance with different amounts of data, which is vital for detecting unique patterns and confirming the model’s consistency in various situations.

In the final steps, we utilize data visualization tools to create visual representations of our decision trees. Additionally, we conduct an exhaustive evaluation of the model, employing a “Confusion Matrix” to illustrate the outcomes clearly.

Information Gain

Information Gain is particularly useful when dealing with categorical target variables using Information Gain for the initial partitioning of a dataset when building a decision tree It’s based on the concept of entropy and aims to maximize the homogeneity of subsets after each split. This approach helps create an effective decision tree by selecting features that provide the most information for predicting the target variable.

1-Information Gain(70%,30%)

# Load the required packages
library(rpart)
library(rpart.plot)
library(caret)

# Set the seed for reproducibility
set.seed(1234)

# Split the data into training and testing sets
ind <- sample(2, nrow(Hobby_Data), replace=TRUE, prob=c(0.7, 0.3))
trainData <- Hobby_Data[ind == 1,]
testData <- Hobby_Data[ind == 2,]

# Define the formula for the decision tree
myFormula <- `Predicted Hobby` ~ Scholarship + Fav_sub + Projects + Grasp_pow + Time_sprt + Career_sprt + Act_sprt + Fant_arts + Won_arts + Time_art + Olympiad_Participation

# Create the decision tree model with the "information" splitting criterion
Hobby_Data_ctree <- rpart(myFormula, data = trainData, method = "class", parms = list(split = "information"))





# Print the decision tree
print(Hobby_Data_ctree)

# Plot the decision tree

rpart.plot(Hobby_Data_ctree)

Decision Tree Analysis Using Information gain(70/30):

In Frist Tree ,we devide dataset into training set and test set with size(%70,%30) respectively. As you can see in the figure, the root node (“Career_sprt”) serves as the starting point for the classification process since have the heights Gain. The dataset has a distribution of approximately 42.47% for class 1(“Academics”), 25.92% for class 2(“Arts”), and 31.61% for class 3 (“Sports”).

The tree further branches based on the values of the “Career_sprt” if equal 0, tree branches based on”Won_arts” ,and majority of instances fall into “Acadimcs”, constituting 63.93% , if”Won_arts” equal 0 or2 In this case the tree terminates with a leaf node indicating a high probability 89.08% for “Acadimcs”.else the instances are classified based on “Fant_arts” into “Arts” with a probability 88%,if equal 0 the instances are classified into “Academics” with a probability of 73% ,else the instances are classified into “Arts” with a high probability 96%, if “Career_sprt” is 1, the tree further branches based on the “Fant_arts” into “Sports” with a probability 80%. If “Fant_arts” is 1 , there is another split based on the “Time_art” feature into “Arts” with a probability 49%. If “Time_art” is greater than or equal to 3, the instances are classified into “Arts” with a probability of 87% . On the other hand, if “Time_art” is less than 3, the instances are classified into “Sports” with a probability of 65% .If “Fant_arts” not equal 1 , the instances are classified into “Sports” with a high probability 95%, as indicated by the leaf node.

First Confusion matrix

# Predict on the test data
testPred <- predict(Hobby_Data_ctree, newdata = testData, type = 'class')

# Check the accuracy of the model
accuracy <- sum(testPred == testData$`Predicted Hobby`) / nrow(testData) * 100
cat('Accuracy:', accuracy, '\n')

# Create a confusion matrix
conf_matrix <- table(Actual = testData$`Predicted Hobby`, Predicted = testPred)

# Calculate precision for each class
precision_class_1 <- conf_matrix[1, 1] / sum(conf_matrix[1, ])
precision_class_2 <- conf_matrix[2, 2] / sum(conf_matrix[2, ])
precision_class_3 <- conf_matrix[3, 3] / sum(conf_matrix[3, ])

# Calculate sensitivity for each class
sensitivity_class_1 <- conf_matrix[1, 1] / sum(conf_matrix[1, ])
sensitivity_class_2 <- conf_matrix[2, 2] / sum(conf_matrix[2, ])
sensitivity_class_3 <- conf_matrix[3, 3] / sum(conf_matrix[3, ])

# Calculate specificity for each class
specificity_class_1 <- sum(diag(conf_matrix[-1, -1])) / sum(conf_matrix[-1, ])
specificity_class_2 <- sum(conf_matrix[c(1, 3), c(1, 3)]) / sum(conf_matrix[c(1, 3), ])
specificity_class_3 <- sum(conf_matrix[c(1, 2), c(1, 2)]) / sum(conf_matrix[c(1, 2), ])

# Calculate macro-average sensitivity
macro_avg_sensitivity <- (sensitivity_class_1 + sensitivity_class_2 + sensitivity_class_3) / 3

# Calculate macro-average specificity
macro_avg_specificity <- (specificity_class_1 + specificity_class_2 + specificity_class_3) / 3

# Calculate macro-average precision
macro_avg_precision <- (precision_class_1 + precision_class_2 + precision_class_3) / 3

# Print macro-average sensitivity
cat('Average Sensitivity:', macro_avg_sensitivity, '\n')

# Print macro-average specificity
cat('Average Specificity:', macro_avg_specificity, '\n')

# Print macro-average precision
cat('Average Precision:', macro_avg_precision, '\n')






# Print precision for each class
cat('Precision for Class 1:', precision_class_1, ' \n')

cat('Precision for Class 2:', precision_class_2, '  \n')
cat('Precision for Class 3:', precision_class_3, ' \n')

# Print sensitivity for each class
cat('Sensitivity for Class 1:', sensitivity_class_1, '\n')
cat('Sensitivity for Class 2:', sensitivity_class_2, '\n')
cat('Sensitivity for Class 3:', sensitivity_class_3, '\n')

# Print specificity for each class
cat('Specificity for Class 1:', specificity_class_1, '\n')
cat('Specificity for Class 2:', specificity_class_2, '\n')
cat('Specificity for Class 3:', specificity_class_3, '\n')

2-Information Gain(80%,20%)

library(rpart)

library(caTools)
library(rpart.plot)
library(caret)

# Set the seed for reproducibility
set.seed(1234)

# Split the data into training and testing sets
ind <- sample(2, nrow(Hobby_Data), replace=TRUE, prob=c(0.8, 0.2))
trainData <- Hobby_Data[ind == 1,]
testData <- Hobby_Data[ind == 2,]

# Define the formula for the decision tree
myFormula <- `Predicted Hobby` ~ Scholarship + Fav_sub + Projects + Grasp_pow + Time_sprt + Career_sprt + Act_sprt + Fant_arts + Won_arts + Time_art + Olympiad_Participation

# Create the decision tree model with the "information" splitting criterion
Hobby_Data_ctree <- rpart(myFormula, data = trainData, method = "class", parms = list(split = "information"))





# Print the decision tree
print(Hobby_Data_ctree)

# Plot the decision tree

rpart.plot(Hobby_Data_ctree)

Decision Tree Analysis Using Information gain(80/20):

In Second Tree ,we devide dataset into training set and test set with size(%80,%20) respectively. As you can see in the figure, the root node (“Career_sprt”) serves as the starting point for the classification process since have the heights Gain. The dataset has a distribution of approximately 43%for class1 (“Academics”), 26% for class 2(“Arts”), and 31% for class 3 (“Sports”).

The tree further branches based on the values of the “Career_sprt” if equal 0, tree branches based on”Won_arts” ,and majority of instances fall into “Acadimcs”, constituting 65% , if”Won_arts” equal 0 or2 In this case the tree terminates with a leaf node indicating a high probability 90% for “Acadimcs”.else the instances are classified based on “Fant_arts”into “Arts” with a probability 88%,if equal 0 the instances are classified into “Academics” with a probability of 72% ,else the instances are classified into “Arts” with a high probability 96%, if “Career_sprt” is 1, the tree further branches based on the “Fant_arts” into “Sports” with a probability 78%. If “Fant_arts” is 1 , there is another split based on the “Time_art” into “Arts” with a probability 50%. If “Time_art” is greater than or equal to 3, the instances are classified into “Arts” with a probability of 85% . On the other hand, if “Time_art” is less than 3, the instances are classified into “Sports” with a probability of 58% .If “Fant_arts” If not equal 1 , the instances are classified into “Sports” with a high probability 94%, as indicated by the leaf node.

Second Confusion matrix

# Predict on the test data
testPred <- predict(Hobby_Data_ctree, newdata = testData, type = 'class')

# Check the accuracy of the model
accuracy <- sum(testPred == testData$`Predicted Hobby`) / nrow(testData) * 100
cat('Accuracy:', accuracy, '\n')

# Create a confusion matrix
conf_matrix <- table(Actual = testData$`Predicted Hobby`, Predicted = testPred)

# Calculate precision for each class
precision_class_1 <- conf_matrix[1, 1] / sum(conf_matrix[1, ])
precision_class_2 <- conf_matrix[2, 2] / sum(conf_matrix[2, ])
precision_class_3 <- conf_matrix[3, 3] / sum(conf_matrix[3, ])

# Calculate sensitivity for each class
sensitivity_class_1 <- conf_matrix[1, 1] / sum(conf_matrix[1, ])
sensitivity_class_2 <- conf_matrix[2, 2] / sum(conf_matrix[2, ])
sensitivity_class_3 <- conf_matrix[3, 3] / sum(conf_matrix[3, ])

# Calculate specificity for each class
specificity_class_1 <- sum(diag(conf_matrix[-1, -1])) / sum(conf_matrix[-1, ])
specificity_class_2 <- sum(conf_matrix[c(1, 3), c(1, 3)]) / sum(conf_matrix[c(1, 3), ])
specificity_class_3 <- sum(conf_matrix[c(1, 2), c(1, 2)]) / sum(conf_matrix[c(1, 2), ])

# Calculate macro-average sensitivity
macro_avg_sensitivity <- (sensitivity_class_1 + sensitivity_class_2 + sensitivity_class_3) / 3

# Calculate macro-average specificity
macro_avg_specificity <- (specificity_class_1 + specificity_class_2 + specificity_class_3) / 3

# Calculate macro-average precision
macro_avg_precision <- (precision_class_1 + precision_class_2 + precision_class_3) / 3

# Print macro-average sensitivity
cat('Average Sensitivity:', macro_avg_sensitivity, '\n')

# Print macro-average specificity
cat('Average Specificity:', macro_avg_specificity, '\n')

# Print macro-average precision
cat('Average Precision:', macro_avg_precision, '\n')






# Print precision for each class
cat('Precision for Class 1:', precision_class_1, ' \n')

cat('Precision for Class 2:', precision_class_2, '  \n')
cat('Precision for Class 3:', precision_class_3, ' \n')

# Print sensitivity for each class
cat('Sensitivity for Class 1:', sensitivity_class_1, '\n')
cat('Sensitivity for Class 2:', sensitivity_class_2, '\n')
cat('Sensitivity for Class 3:', sensitivity_class_3, '\n')

# Print specificity for each class
cat('Specificity for Class 1:', specificity_class_1, '\n')
cat('Specificity for Class 2:', specificity_class_2, '\n')
cat('Specificity for Class 3:', specificity_class_3, '\n')

3-Information Gain(90%,10%)

library(rpart)

library(caTools)
library(rpart.plot)
library(caret)
# Set the seed for reproducibility
set.seed(1234)

# Split the data into training and testing sets
ind <- sample(2, nrow(Hobby_Data), replace=TRUE, prob=c(0.9, 0.1))
trainData <- Hobby_Data[ind == 1,]
testData <- Hobby_Data[ind == 2,]

# Define the formula for the decision tree
myFormula <- `Predicted Hobby` ~ Scholarship + Fav_sub + Projects + Grasp_pow + Time_sprt + Career_sprt + Act_sprt + Fant_arts + Won_arts + Time_art + Olympiad_Participation

# Create the decision tree model with the "information" splitting criterion
Hobby_Data_ctree <- rpart(myFormula, data = trainData, method = "class", parms = list(split = "information"))



# Print the decision tree
print(Hobby_Data_ctree)

# Plot the decision tree

rpart.plot(Hobby_Data_ctree)

Decision Tree Analysis Using Information gain(90/10):

In Third Tree ,we devide dataset into training set and test set with size(%90,%10) respectively. As you can see in the figure, the root node (“Career_sprt”) serves as the starting point for the classification process since have the heights Gain. The dataset has a distribution of approximately 43% for class 1(“Academics”), 25% for class 2(“Arts”), and 32% for class 3 (“Sports”).

The tree further branches based on the values of the “Career_sprt” if equal 0, tree branches based on”Won_arts” ,and majority of instances fall into “Acadimcs”, constituting 65% , if”Won_arts” equal 0 or 2 In this case the tree terminates with a leaf node indicating a high probability 90% for “Acadimcs”.else the instances are classified based on “Fant_arts”into “Arts” with a probability 87%,if equal 0 the instances are classified into “Academics” with a probability of 74% ,else the instances are classified into “Arts” with a high probability 96%, if “Career_sprt” is 1, the tree further branches based on the “Fant_arts” into “Sports” with a probability 79%. If “Fant_arts” is 1 , there is another split based on the “Time_art” into “Arts” with a probability 48%. If “Time_art” is greater than or equal to 3, the instances are classified into “Arts” with a probability of 84% . On the other hand, if “Time_art” is less than 3, the instances are classified based on”Act_sprt ” into “Sports” with a probability of 58% .if “Act_sprt” equal 0 the instances are classified into “Academics” with a probability of 59%, other hand the instances are classified into “Sports” with a probability of 78%. If “Fant_arts” not equal 1 , the instances are classified into “Sports” with a high probability 94%, as indicated by the leaf node.

Third Confusion matrix

# Predict on the test data
testPred <- predict(Hobby_Data_ctree, newdata = testData, type = 'class')

# Check the accuracy of the model
accuracy <- sum(testPred == testData$`Predicted Hobby`) / nrow(testData) * 100
cat('Accuracy:', accuracy, '\n')

# Create a confusion matrix
conf_matrix <- table(Actual = testData$`Predicted Hobby`, Predicted = testPred)

# Calculate precision for each class
precision_class_1 <- conf_matrix[1, 1] / sum(conf_matrix[1, ])
precision_class_2 <- conf_matrix[2, 2] / sum(conf_matrix[2, ])
precision_class_3 <- conf_matrix[3, 3] / sum(conf_matrix[3, ])

# Calculate sensitivity for each class
sensitivity_class_1 <- conf_matrix[1, 1] / sum(conf_matrix[1, ])
sensitivity_class_2 <- conf_matrix[2, 2] / sum(conf_matrix[2, ])
sensitivity_class_3 <- conf_matrix[3, 3] / sum(conf_matrix[3, ])

# Calculate specificity for each class
specificity_class_1 <- sum(diag(conf_matrix[-1, -1])) / sum(conf_matrix[-1, ])
specificity_class_2 <- sum(conf_matrix[c(1, 3), c(1, 3)]) / sum(conf_matrix[c(1, 3), ])
specificity_class_3 <- sum(conf_matrix[c(1, 2), c(1, 2)]) / sum(conf_matrix[c(1, 2), ])

# Calculate macro-average sensitivity
macro_avg_sensitivity <- (sensitivity_class_1 + sensitivity_class_2 + sensitivity_class_3) / 3

# Calculate macro-average specificity
macro_avg_specificity <- (specificity_class_1 + specificity_class_2 + specificity_class_3) / 3

# Calculate macro-average precision
macro_avg_precision <- (precision_class_1 + precision_class_2 + precision_class_3) / 3

# Print macro-average sensitivity
cat('Average Sensitivity:', macro_avg_sensitivity, '\n')

# Print macro-average specificity
cat('Average Specificity:', macro_avg_specificity, '\n')

# Print macro-average precision
cat('Average Precision:', macro_avg_precision, '\n')






# Print precision for each class
cat('Precision for Class 1:', precision_class_1, ' \n')

cat('Precision for Class 2:', precision_class_2, '  \n')
cat('Precision for Class 3:', precision_class_3, ' \n')

# Print sensitivity for each class
cat('Sensitivity for Class 1:', sensitivity_class_1, '\n')
cat('Sensitivity for Class 2:', sensitivity_class_2, '\n')
cat('Sensitivity for Class 3:', sensitivity_class_3, '\n')

# Print specificity for each class
cat('Specificity for Class 1:', specificity_class_1, '\n')
cat('Specificity for Class 2:', specificity_class_2, '\n')
cat('Specificity for Class 3:', specificity_class_3, '\n')

Comparing Decision Tree Results Using Infromation gain: After training three trees with different sizes, employing information gain as the selection measure, our analysis led to consistent accuracy results among the trees: Tree 1 (0.8932), Tree 2 (0.9057), and Tree 3 (0.8721). The minor discrepancies observed in these accuracy values could be attributed to the variations in dataset sizes. Investigating the impact of different training set sizes on model performance offers valuable insights into the intricate relationship between data size and accuracy.

In the case of Tree 2, where a larger training set was employed (80% training, 20% testing), the model had the opportunity to grasp more robust patterns and relationships within the data. However, it is crucial to underscore the necessity of striking a balance between the sizes of the training and testing sets. For Tree 3, with a relatively smaller testing set (90% training, 10% testing), the accuracy estimate might be less reliable due to the limited sample size in the testing set.

In summary, the utilization of information gain as the selection measure, coupled with different training set sizes, resulted in comparable accuracy outcomes. Achieving an optimal balance in the sizes of both training and testing datasets proves essential for ensuring accurate and generalizable model performance. +——————+——————-+——————-+——————-+ | information gain | 90 %t raining set | 80 %t raining set | 70 %t raining set | | | | | | | | 10% testing set: | 20% testing set: | 30% testing set: | +:================:+:=================:+:=================:+:=================:+ | Accuracy | 0.872 | 0.905 | 0.893 | +——————+——————-+——————-+——————-+ | precision | 0.856 | 0.898 | 0.887 | +——————+——————-+——————-+——————-+ | sensitivity | 0.856 | 0.898 | 0.887 | +——————+——————-+——————-+——————-+ | specificity | 0.919 | 0.937 | 0.929 | +——————+——————-+——————-+——————-+

Gini index

The Gini index, is a measure used in decision trees, specifically in the CART (Classification and Regression Trees) algorithm, to quantify how often a randomly chosen element would be incorrectly labeled if it was randomly labeled according to the distribution of labels in the subset. It reflects the probability of a particular variable being wrongly classified when it is randomly chosen.

1-Gini index(80%,20%)

Install necessary libraries

install.packages("rpart")
install.packages("rpart.plot")
install.packages("caTools")
install.packages("caret")

Load necessary libraries

library(rpart)
library(rpart.plot)
library(caTools)
library(caret)

Set a seed for reproducibility

set.seed(123)

Split the dataset, 80% for training, 20% for testing

split <- sample.split(Hobby_Data$`Predicted Hobby`, SplitRatio = 0.80)

Create the training set (80% of the data)

training_set <- subset(Hobby_Data, split == TRUE)

Create the test set (20% of the data)

test_set <- subset(Hobby_Data, split == FALSE)

Build a decision tree model on the training set

tree <- rpart(`Predicted Hobby` ~ ., data = training_set, method = 'class')

Make predictions on the test set using the tree model

predictions <- predict(tree, test_set, type = "class")

Confusion matrix

conf_matrix <- table(Predicted = predictions, Actual = test_set$`Predicted Hobby`)

Calculate accuracy

accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)

Initialize vectors to hold the metrics for each class

precision <- numeric(length = nrow(conf_matrix))
recall <- numeric(length = nrow(conf_matrix))
specificity <- numeric(length = nrow(conf_matrix))

Calculate metrics for each class

for (i in 1:nrow(conf_matrix)) {
  TP <- conf_matrix[i, i]
  FP <- sum(conf_matrix[, i]) - TP
  FN <- sum(conf_matrix[i, ]) - TP
  TN <- sum(conf_matrix) - TP - FP - FN
  
  precision[i] <- TP / (TP + FP)
  recall[i] <- TP / (TP + FN)
  specificity[i] <- TN / (TN + FP)
}

Average the metrics if you want a single performance measure

avg_precision <- mean(precision)
avg_recall <- mean(recall)
avg_specificity <- mean(specificity)

Output the evaluation metrics

print(paste("Overall Accuracy:", accuracy))
print(paste("Average Precision:", avg_precision))
print(paste("Average Recall (Sensitivity):", avg_recall))
print(paste("Average Specificity:", avg_specificity))

the metrics for each class:

metrics <- data.frame(
  Class = rownames(conf_matrix),
  Precision = precision,
  Recall = recall,
  Specificity = specificity
)

Print metrics

print(metrics)

Plot the decision tree

rpart.plot(tree)

Decision Tree Analysis Using Gini Index(80/20): The decision tree delineates hobbies into ‘Academics’ (1), ‘Arts’ (2), and ‘Sports’ (3). Without a sports hobby (‘Career_sprt’ = 0), the model suggests a 62% chance of ‘Academics’. With no arts hobby (‘Fant_arts’ = 0) and ‘Won_arts’ at 0 or 2, there’s a 43% chance of an ‘Academics’ categorization. Conversely, for those with an arts hobby (‘Fant_arts’ = 1) and frequent arts activities (‘Time_art’ ≥ 3), These model show how likely the model is to predict each hobby based on the attributes’ significance, as learned from the data with a 80% training portion

2-Gini index(90%,10%)

Install necessary libraries

install.packages("rpart")
install.packages("rpart.plot")
install.packages("caTools")
install.packages("caret")

Load necessary libraries

library(rpart)
library(rpart.plot)
library(caTools)
library(caret)

Set a seed for reproducibility

set.seed(123)

Split the dataset, 90% for training, 10% for testing

split <- sample.split(Hobby_Data$`Predicted Hobby`, SplitRatio = 0.90)

Create the training set (90% of the data)

training_set <- subset(Hobby_Data, split == TRUE)

Create the test set (10% of the data)

test_set <- subset(Hobby_Data, split == FALSE)

Build a decision tree model on the training set

tree <- rpart(`Predicted Hobby` ~ ., data = training_set, method = 'class')

Make predictions on the test set using the tree model

predictions <- predict(tree, test_set, type = "class")

Confusion matrix

conf_matrix <- table(Predicted = predictions, Actual = test_set$`Predicted Hobby`)

Calculate accuracy

accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)

Initialize vectors to hold the metrics for each class

precision <- numeric(length = nrow(conf_matrix))
recall <- numeric(length = nrow(conf_matrix))
specificity <- numeric(length = nrow(conf_matrix))

Calculate metrics for each class

for (i in 1:nrow(conf_matrix)) {
  TP <- conf_matrix[i, i]
  FP <- sum(conf_matrix[, i]) - TP
  FN <- sum(conf_matrix[i, ]) - TP
  TN <- sum(conf_matrix) - TP - FP - FN
  
  precision[i] <- TP / (TP + FP)
  recall[i] <- TP / (TP + FN)
  specificity[i] <- TN / (TN + FP)
}

Average the metrics if you want a single performance measure

avg_precision <- mean(precision)
avg_recall <- mean(recall)
avg_specificity <- mean(specificity)

Output the evaluation metrics

print(paste("Overall Accuracy:", accuracy))
print(paste("Average Precision:", avg_precision))
print(paste("Average Recall (Sensitivity):", avg_recall))
print(paste("Average Specificity:", avg_specificity))

the metrics for each class:

metrics <- data.frame(
  Class = rownames(conf_matrix),
  Precision = precision,
  Recall = recall,
  Specificity = specificity
)

Print metrics

print(metrics)

Plot the decision tree

rpart.plot(tree)

Decision Tree Analysis Using Gini Index(90/10):

The decision tree classifies hobbies into ‘Academics’ (1), ‘Arts’ (2), and ‘Sports’ (3). A lack of a sports hobby (‘Career_sprt’ = 0) leads to a 63% chance of falling into ‘Academics’. If someone is not engaged in an arts hobby (‘Fant_arts’ = 0) and ‘Won_arts’ is 0 or 2, there’s a 43% probability of an ‘Academics’ categorization. For individuals engaged in an arts hobby (‘Fant_arts’ = 1) with a high level of arts activity (‘Time_art’ ≥ 3), the likelihood of a ‘Sports’ classification is 28%. These model show how likely the model is to predict each hobby based on the attributes’ significance, as learned from the data with a 90% training portion.

3-Gini index(70%,30%)

Install necessary libraries

install.packages("rpart")
install.packages("rpart.plot")
install.packages("caTools")
install.packages("caret")

Load necessary libraries

library(rpart)
library(rpart.plot)
library(caTools)
library(caret)

Set a seed for reproducibility

set.seed(123)

Split the dataset, 70% for training, 30% for testing

split <- sample.split(Hobby_Data$`Predicted Hobby`, SplitRatio = 0.70)

Create the training set (70% of the data)

training_set <- subset(Hobby_Data, split == TRUE)

Create the test set (20% of the data)

test_set <- subset(Hobby_Data, split == FALSE)

Build a decision tree model on the training set

tree <- rpart(`Predicted Hobby` ~ ., data = training_set, method = 'class')

Make predictions on the test set using the tree model

predictions <- predict(tree, test_set, type = "class")

Confusion matrix

conf_matrix <- table(Predicted = predictions, Actual = test_set$`Predicted Hobby`)

Calculate accuracy

accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)

Initialize vectors to hold the metrics for each class

precision <- numeric(length = nrow(conf_matrix))
recall <- numeric(length = nrow(conf_matrix))
specificity <- numeric(length = nrow(conf_matrix))

Calculate metrics for each class

for (i in 1:nrow(conf_matrix)) {
  TP <- conf_matrix[i, i]
  FP <- sum(conf_matrix[, i]) - TP
  FN <- sum(conf_matrix[i, ]) - TP
  TN <- sum(conf_matrix) - TP - FP - FN
  
  precision[i] <- TP / (TP + FP)
  recall[i] <- TP / (TP + FN)
  specificity[i] <- TN / (TN + FP)
}

Average the metrics if you want a single performance measure

avg_precision <- mean(precision)
avg_recall <- mean(recall)
avg_specificity <- mean(specificity)

Output the evaluation metrics

print(paste("Overall Accuracy:", accuracy))
print(paste("Average Precision:", avg_precision))
print(paste("Average Recall (Sensitivity):", avg_recall))
print(paste("Average Specificity:", avg_specificity))

the metrics for each class:

metrics <- data.frame(
  Class = rownames(conf_matrix),
  Precision = precision,
  Recall = recall,
  Specificity = specificity
)

Print metrics

print(metrics)

Plot the decision tree

rpart.plot(tree)

Decision Tree Analysis Using Gini Index(70/30):

The decision tree sorts hobbies into ‘Academics’ (1), ‘Arts’ (2), and ‘Sports’ (3). A non-sports hobby (‘Career_sprt’ = 0) results in a 63% probability of an ‘Academics’ categorization. If ‘Fant_arts’ is 0 and ‘Won_arts’ is 0 or 2, there’s a 43% chance of being classified as ‘Academics’. Conversely, for those involved in an arts hobby (‘Fant_arts’ = 1) with significant arts activity (‘Time_art’ ≥ 3), the model indicates a 28% probability of a ‘Sports’ hobby. This decision tree demonstrates the likelihood of predicting each hobby based on the importance of the attributes, as determined from the data trained with a 70% portion.

Comparing Decision Tree Results Using Gini Index:

Across Three Training-Test Sizes: The results of the decision trees from the 90/10, 80/20, and 70/30 dataset splits, there is a consistent pattern: ‘Career_sprt’ is always the root node, and the subsequent splits on ‘Won_arts’ and ‘Fant_arts’ are the same across all trees. This consistency in tree structure and the probabilities for predicting ‘Academics’ and ‘Sports’ across different splits suggest a stable and robust model that is reliable regardless of the training set size.

the accuracies of three data splits reveals distinct outcomes: the (90,10) split leads with the highest accuracy at 0.91875, suggesting that a larger training portion is more effective in this case. The (70,30) split follows with an accuracy of 0.91060, showing strong performance even with a larger test set. However, the commonly used (80,20) split lags slightly behind, achieving an accuracy of 0.90625. This comparison highlights the impact of varying training and testing proportions on model accuracy.

Gini index	90 %t raining set 10% testing set:	80 %t raining set 20% testing set:	70 %t raining set 30% testing set:
Accuracy	0.91875	0.906	0.911
precision	0.91850	0.905	0.909
sensitivity	0.91927	0.909	0.912
specificity	0.9578	0.952	0.954

Gain Ratio The third criterion employed for building the decision tree is Gain Ratio. Gain Ratio stands out as a significant metric in decision tree algorithms, especially in scenarios involving categorical target variables. It normalizes the reduction in entropy by taking into account the potential information content of the feature. This normalization process makes Gain Ratio particularly suitable for datasets with categorical target variables. By factoring in the intrinsic information of a split, Gain Ratio effectively mitigates bias towards features with higher levels, ensuring a more balanced evaluation of different attributes.

1-Gain ratio(90%,10%)

Install necessary libraries

install.packages("C50")
install.packages("printr")
install.packages("caret")

Load necessary libraries

library(C50)
library(printr)
library(caret)

Set a seed for reproducibility

set.seed(1958)

Splitting the data into training and test sets

train_indices <- sample(1:nrow(Hobby_Data), 0.9 * nrow(Hobby_Data))
Hobby.train <- Hobby_Data[train_indices, ]
Hobby.test <- Hobby_Data[-train_indices, ]

Training the decision tree model

model <- C5.0(`Predicted Hobby` ~ ., data = Hobby.train, control = C5.0Control(CF = 0.01))

Making predictions on the test set

predictions <- predict(model, newdata = Hobby.test, type = 'class')

Create a confusion matrix from the predictions and actual values

conf_matrix <- table(Predicted = predictions, Actual = Hobby.test$`Predicted Hobby`)

Calculate and print the accuracy of the model

accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
print(paste('Accuracy on test data is:', accuracy))

Initialize vectors to hold the metrics for each class

precision <- numeric(length = nrow(conf_matrix))
recall <- numeric(length = nrow(conf_matrix))
specificity <- numeric(length = nrow(conf_matrix))

Calculate metrics for each class

for (i in 1:nrow(conf_matrix)) {
  TP <- conf_matrix[i, i]
  FP <- sum(conf_matrix[, i]) - TP
  FN <- sum(conf_matrix[i, ]) - TP
  TN <- sum(conf_matrix) - TP - FP - FN
  
  precision[i] <- TP / (TP + FP)
  recall[i] <- TP / (TP + FN)
  specificity[i] <- TN / (TN + FP)
}

Average the metrics if you want a single performance measure

avg_precision <- mean(precision)
avg_recall <- mean(recall)
avg_specificity <- mean(specificity)

Output the evaluation metrics

print(paste("Overall Accuracy:", accuracy))
print(paste("Average Precision:", avg_precision))
print(paste("Average Recall (Sensitivity):", avg_recall))
print(paste("Average Specificity:", avg_specificity))

print the metrics for each class:

metrics <- data.frame(
  Class = rownames(conf_matrix),
  Precision = precision,
  Recall = recall,
  Specificity = specificity
)

Print metrics

print(metrics)

Generate and print additional performance metrics using caret package

confusionMatrix(predictions, Hobby.test$`Predicted Hobby`)

Plot the decision tree

plot(model)

Decision Tree Analysis Using Gain Ratio(90%/10%):

In First Tree ,we devide dataset into training set and test set with size(%90,%10) respectively. As you can see in the figure, the root node is “Career_sprt” , class 1(“Academics”), class 2(“Arts”), and class 3 (“Sports”).

Node “Career_sprt” The first decision is based on whether the value of the “Career_sprt” attribute is 0. then check if “Won_arts” is either 0 or 2.If” Won_arts” is 0 or 2 , predict”Academic”.then check If “Fant_arts” is 1 “and Won_arts” is 1, predict “Arts”.If “Fant_arts” is 0 and Won_arts is 0 or 2, then check if Olympiad_Participation is 1.If Olympiad_Participation is 1 predict “Academics”.(When Olympiad_Participation is 0) If “Olympiad_Participation” is 0 and “Fant_arts” is 0, then check if “Grasp_pow” is less than or equal to 4 , predict class”Arts”.When Career_sprt is 1, then check if “Fant_arts” is 0 then predict “Sports”. If “Fant_arts” is 1, then check if “Time_art” is greater than 2.check if “Time_art” is less than or equal to 2, then check if “Act_sprt” is 1 or 0.If Act_sprt is 1, predict “Sports”. If Act_sprt is 0, then check if Olympiad_Participation is 0 predict “Arts”. If “Olympiad_Participation” is 1, predict “Academics”.When Time_art is greater than 2 ,If Won_arts is 0, predict class “Sports”.

2-Gain ratio(80%,20%)

Install necessary libraries

install.packages("C50")
install.packages("printr")
install.packages("caret")

Load necessary libraries

library(C50)
library(printr)
library(caret)

Set a seed for reproducibility

set.seed(1958)

Splitting the data into training and test sets

train_indices <- sample(1:nrow(Hobby_Data), 0.8 * nrow(Hobby_Data))
Hobby.train <- Hobby_Data[train_indices, ]
Hobby.test <- Hobby_Data[-train_indices, ]

Training the decision tree model

model <- C5.0(`Predicted Hobby` ~ ., data = Hobby.train, control = C5.0Control(CF = 0.01))

Making predictions on the test set

predictions <- predict(model, newdata = Hobby.test, type = 'class')

Create a confusion matrix from the predictions and actual values

conf_matrix <- table(Predicted = predictions, Actual = Hobby.test$`Predicted Hobby`)

Calculate and print the accuracy of the model

accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
print(paste('Accuracy on test data is:', accuracy))

Initialize vectors to hold the metrics for each class

precision <- numeric(length = nrow(conf_matrix))
recall <- numeric(length = nrow(conf_matrix))
specificity <- numeric(length = nrow(conf_matrix))

Calculate metrics for each class

for (i in 1:nrow(conf_matrix)) {
  TP <- conf_matrix[i, i]
  FP <- sum(conf_matrix[, i]) - TP
  FN <- sum(conf_matrix[i, ]) - TP
  TN <- sum(conf_matrix) - TP - FP - FN
  
  precision[i] <- TP / (TP + FP)
  recall[i] <- TP / (TP + FN)
  specificity[i] <- TN / (TN + FP)
}

Average the metrics if you want a single performance measure

avg_precision <- mean(precision)
avg_recall <- mean(recall)
avg_specificity <- mean(specificity)

Output the evaluation metrics

print(paste("Overall Accuracy:", accuracy))
print(paste("Average Precision:", avg_precision))
print(paste("Average Recall (Sensitivity):", avg_recall))
print(paste("Average Specificity:", avg_specificity))

print the metrics for each class:

metrics <- data.frame(
  Class = rownames(conf_matrix),
  Precision = precision,
  Recall = recall,
  Specificity = specificity
)

Print metrics

print(metrics)

Generate and print additional performance metrics using caret package

confusionMatrix(predictions, Hobby.test$`Predicted Hobby`)

Plot the decision tree

plot(model)

Decision Tree Analysis Using Gain Ratio(80/20):

The decision tree depicted classifies hobbies into ‘Academics’ (1), ‘Arts’ (2), and ‘Sports’ (3). It starts with ‘Career_sprt’ a value of 0 leads to ‘Won_arts’. If ‘Won_arts’ is 0 or 2, the model suggests ‘Academics’ or ‘Arts’. If ‘Career_sprt’ is 1, ‘Fant_arts’ is considered next; a value of 0 after ‘Won_arts’ being 1 points towards ‘Arts’, while a value of 1 leads to ‘Olympiad_Participation’, which, if 1, indicates ‘Academics’. Conversely, a high ‘Grasp_pow’ (>4) predicts ‘Sports’.

3-Gain ratio(70%,30%)

Install necessary libraries

install.packages("C50")
install.packages("printr")
install.packages("caret")

Load necessary libraries

library(C50)
library(printr)
library(caret)

Set a seed for reproducibility

set.seed(1958)

Splitting the data into training and test sets

train_indices <- sample(1:nrow(Hobby_Data), 0.7 * nrow(Hobby_Data))
Hobby.train <- Hobby_Data[train_indices, ]
Hobby.test <- Hobby_Data[-train_indices, ]

Training the decision tree model

model <- C5.0(`Predicted Hobby` ~ ., data = Hobby.train, control = C5.0Control(CF = 0.01))

Making predictions on the test set

predictions <- predict(model, newdata = Hobby.test, type = 'class')

Create a confusion matrix from the predictions and actual values

conf_matrix <- table(Predicted = predictions, Actual = Hobby.test$`Predicted Hobby`)

Calculate and print the accuracy of the model

accuracy <- sum(diag(conf_matrix)) / sum(conf_matrix)
print(paste('Accuracy on test data is:', accuracy))

Initialize vectors to hold the metrics for each class

precision <- numeric(length = nrow(conf_matrix))
recall <- numeric(length = nrow(conf_matrix))
specificity <- numeric(length = nrow(conf_matrix))

Calculate metrics for each class

for (i in 1:nrow(conf_matrix)) {
  TP <- conf_matrix[i, i]
  FP <- sum(conf_matrix[, i]) - TP
  FN <- sum(conf_matrix[i, ]) - TP
  TN <- sum(conf_matrix) - TP - FP - FN
  
  precision[i] <- TP / (TP + FP)
  recall[i] <- TP / (TP + FN)
  specificity[i] <- TN / (TN + FP)
}

Average the metrics if you want a single performance measure

avg_precision <- mean(precision)
avg_recall <- mean(recall)
avg_specificity <- mean(specificity)

Output the evaluation metrics

print(paste("Overall Accuracy:", accuracy))
print(paste("Average Precision:", avg_precision))
print(paste("Average Recall (Sensitivity):", avg_recall))
print(paste("Average Specificity:", avg_specificity))

print the metrics for each class:

metrics <- data.frame(
  Class = rownames(conf_matrix),
  Precision = precision,
  Recall = recall,
  Specificity = specificity
)

Print metrics

print(metrics)

Generate and print additional performance metrics using caret package

confusionMatrix(predictions, Hobby.test$`Predicted Hobby`)

Plot the decision tree

plot(model)

Decision Tree Analysis Using Gain Ratio(70%/30%):

In Third Tree ,we devide dataset into training set and test set with size(%70,%30) respectively. As you can see in the figure, the root node is “Career_sprt” , class 1(“Academics”), class 2(“Arts”), and class 3 (“Sports”).

The first decision is based on whether the value of the “Career_sprt” attribute is 0.If “Career_sprt” is 0, then check if “Won_arts” is either 0 or 2.predict “Academics”.If “Won_arts” is 1, then check if “Fant_arts” is 1,predict “Arts”.If ““Fant_arts is 0 and”Won_arts” is 0 or 2, then check if “Time_art” is less than or equal to 2,predict “Academics”. If “Time_art” is greater than 2, predict “Arts”.

If “Career_sprt”is 1, then check if “Fant_arts” is 0, predict “Sports”.If “Fant_arts”is 1, then check if “Time_art” is less than or equal to 2 check if “Act_sprt” is 0,predict “Academics” .If “Act_sprt” is 1 predict “Sports”. if “Time_art” is greater than 2, then check if “Won_arts” is 0 predict “Sports”.If “Won_arts” is 1 or 2 predict “Arts”.

Comparing Decision Tree Results Using Gain Ratio

Across Three Training-Test Sizes: The accuracy rates -0.8944 for the 90:10 split, 0.8939 for the 70:30 split, and 0.8879 for the 80:20 split – indicate only slight variations, with the 90:10 split being marginally better.

Gain ratio	90 %t raining set 10% testing set:	80 %t raining set 20% testing set:	70 %t raining set 30% testing set:
Accuracy	0.8944	0.888	0.893970893970894
precision	0.892	0.881	0.890
sensitivity	0.891	0.890	0.902
specificity	0.945	0.943	0.947

————————————————-Clustering————————————————————-

str(Hobby_proc)

<<<<<<< Updated upstream =======

 num [1:1601, 1:12] 0.973 0.973 0.973 0.973 0.973 ...
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr [1:12] "Olympiad_Participation" "Scholarship" "Fav_sub" "Projects" ...
 - attr(*, "scaled:center")= Named num [1:12] 0.513 0.417 2.112 0.578 3.48 ...
  ..- attr(*, "names")= chr [1:12] "Olympiad_Participation" "Scholarship" "Fav_sub" "Projects" ...
 - attr(*, "scaled:scale")= Named num [1:12] 0.5 0.493 1.05 0.494 1.007 ...
  ..- attr(*, "names")= chr [1:12] "Olympiad_Participation" "Scholarship" "Fav_sub" "Projects" ...

>>>>>>> Stashed changes

To convert type from factor columns to numeric

Hobby_proc$Fav_sub <-as.numeric(Hobby_proc$Fav_sub)

Hobby_proc$Olympiad_Participation <-as.numeric(Hobby_proc$Olympiad_Participation)

Hobby_proc$Projects <-as.numeric(Hobby_proc$Projects)

Hobby_proc$Scholarship <-as.numeric(Hobby_proc$Scholarship)

Hobby_proc$Career_sprt <-as.numeric(Hobby_proc$Career_sprt)

Hobby_proc$Act_sprt <-as.numeric(Hobby_proc$Act_sprt)

Hobby_proc$Fant_arts <-as.numeric(Hobby_proc$Fant_arts)

Hobby_proc$Won_arts <-as.numeric(Hobby_proc$Won_arts)

Hobby_proc$`Predicted Hobby` <-as.numeric(Hobby_proc$`Predicted Hobby` )

str(Hobby_proc)

<<<<<<< Updated upstream =======

 num [1:1601, 1:12] 0.973 0.973 0.973 0.973 0.973 ...
 - attr(*, "scaled:center")= Named num [1:12] 2.57e-17 6.36e-17 -1.29e-16 1.69e-17 1.72e-17 ...
  ..- attr(*, "names")= chr [1:12] "Olympiad_Participation" "Scholarship" "Fav_sub" "Projects" ...
 - attr(*, "scaled:scale")= Named num [1:12] 1 1 1 1 1 1 1 1 1 1 ...
  ..- attr(*, "names")= chr [1:12] "Olympiad_Participation" "Scholarship" "Fav_sub" "Projects" ...
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr [1:12] "Olympiad_Participation" "Scholarship" "Fav_sub" "Projects" ...

>>>>>>> Stashed changes

Scaled All Columns

Hobby_proc <-scale(Hobby_proc)

Data set without ground truth

Hobby_Data2 <- Hobby_proc[, !(colnames(Hobby_proc) %in% c("Predict Hobby"))]

Our data set exhibits a balanced distribution among class labels, with “academic,” “art,” and “sport” constituting 43.6%, 25.6%, and 30.8% of the total, respectively. This balanced distribution is advantageous for both classification and clustering tasks. In classification, a balanced data set helps prevent the model from favoring one class over the others, ensuring that the learning algorithm is exposed to a representative set of examples from each category. This balance promotes the development of a model that generalizes well across all classes, enhancing its predictive performance on new, unseen data. In clustering, a balanced data set aids in forming clusters that are more evenly distributed, allowing for a comprehensive understanding of patterns and relationships across diverse categories. Balanced data sets often lead to more accurate and fair clustering results, enabling meaningful insights into the underlying structures within each class.

require packages/Library

install.packages("ggplot2") 
install.packages("magrittr")
install.packages("dplyr")
library(factoextra) 
library(cluster)
library(dplyr)

———————————————k-meansclustering————————————————

Validation:

Determining the right number of clusters before starting the clustering process is like making sure you have the correct-sized puzzle pieces before putting the puzzle together. It’s important because some clustering algorithms, like K-means, require such a parameter. In addition to that, it helps make the clustering more accurate and useful. If you know the right number beforehand, it saves time and helps make the whole process more efficient and the results more reliable.

compute average silhouette for k clusters using silhouette() For k-mean

silhouette_score <- function(k) {
  km <- kmeans(Hobby_Data2, centers = k, nstart = 25)
  ss <- silhouette(km$cluster, dist(Hobby_Data2))
  sil <- mean(ss[, 3])
  return(sil)
}

# k cluster range from 2 to 10
k <- 2:10

# call function for each k value
avg_sil <- sapply(k, silhouette_score)

# plot the results
plot(k, avg_sil, type = 'b', xlab = 'Number of clusters', ylab = 'Average Silhouette Scores', frame = FALSE)

The results indicate that the highest average silhouette scores indicate the quality of the clusters and suggest better-defined and more separated clusters, with each point having a high degree of similarity to its own cluster and a lower similarity to neighboring clusters. The highest average silhouette scores were observed for k values of 3, 2, and 4, so these are the optimal numbers. These values will be employed in subsequent k-means clustering analyses.

k-means cluster k=3

#set a seed for random number generation  to make the results reproducible
set.seed(7)
kmeans.result <- kmeans(Hobby_Data2, 3)

# print the clusterng result
kmeans.result

#visualize clustering
fviz_cluster(kmeans.result, data = Hobby_Data2)

Average for each cluster

avg_sil <- silhouette(kmeans.result$cluster,dist(Hobby_Data2)) 
fviz_silhouette(avg_sil)

the presence of negative silhouettes for some observations within each cluster indicates that these points might be more similar to points in other clusters, suggesting a potential overlap or ambiguity in their assignment. The fact that some observations have negative silhouettes highlights that the separation of data points is not entirely sufficient.

So since 3, which was the optimal number of clusters with the highest silhouette score average, did not have good clustering results, that does support our research results that the k-means algorithm is not applicable to categoricaldata clustering because it relies on the Euclidean distance metric tomeasure the similarity between data points. However, even afterEncoding and its application to categorical data pose significant challenges. Categorical variables often lack a meaningful numericalrepresentation; for instance, taking the mean of categories like thefeature “favorite subject,” aka Fav_sub” (even after encoding), might nothave any practical interpretation. And the distances calculated in thealgorithm may not reflect the true dissimilarities between categoricalvalues. The encoding process itself introduces artificial numericalrelationships that may mislead the algorithm. Moreover, k-means relieson the minimization of Euclidean distances, which might not accuratelycapture the dissimilarity structure in categorical data. Categoricalvariables inherently exhibit discrete and non-ordinal characteristicsthat are not well-suited for the continuous and linear assumptions ofk-means. Alternative clustering techniques, specifically designed forcategorical data, such as partitioning around medoids, are moreappropriate for capturing the intrinsic patterns and relationships incategorical datasets.

————————————————–k-mediods clustering with PAM——————————————–

K-medoids clustering presents a robust alternative for analyzing categorical data by addressing the limitations posed by k-means clustering. Unlike k-means, k-medoids does not rely on the mean as a representative centroid but employs medoids, which are actual data points within the clusters, and the algorithm defines clusters based on partitioning around medoids. This feature makes k-medoids particularly suitable for categorical data, where meaningful centroids may not have a numerical interpretation. The algorithm defines clusters based on partitioning around medoids.

Validation:

First, we want to determine three different numbers of clusters by using a number of methods that will suggest the optimal number of clusters for k-mediods clustering with PAM.

Silhouette coefficient

fviz_nbclust(Hobby_Data2, pam, method = "silhouette")+
  labs(subtitle = "Silhouette method")

Elbow method

fviz_nbclust(Hobby_Data2, pam, method = "wss") +
  geom_vline(xintercept= 3, linetype= 3)+
  labs(subtitle = "Elbow method")

The silhouette coefficient, which measures the cohesion and separation of clusters, aligns with the Elbow method, which assesses the within-cluster sum of squares (wss) as a function of the number of clusters in the suggested optimal number of clusters. This alignment in results between two distinct evaluation methods strengthens confidence in the choice of three clusters, providing a stable foundation for further analysis and interpretation of the underlying patterns within the dataset. In addition to that, the ground truth (class labels) also contains three classes, and that indicates a reassuring alignment between the structure of the data and the clustering results.

We need to determine two more suggested numbers of clusters by computing the average silhouette for k clusters using silhouette().

silhouette_score <- function(k) {
  km <- pam(Hobby_Data2, k, diss = TRUE)
  ss <- silhouette(km$clustering, dist(Hobby_Data2))
  sil <- mean(ss[, 3])
  return(sil)
}

# k cluster range from 2 to 10
k <- 2:10

# Call function for each k value
avg_sil <- sapply(k, silhouette_score)

# Plot the results
plot(k, avg_sil, type = 'b', xlab = 'Number of clusters', ylab = 'Average Silhouette Scores', frame = FALSE)

It is a common practice to choose the number of clusters corresponding to the peak in the silhouette score plot, and since we are looking for two more number of clusters other than three, it would be reasonable to consider two and four clusters for further analysis. Especially with the decreasing trend beyond three clusters, it indicates that adding more clusters does not significantly improve the separation and cohesion of the clusters.

————————————————–group into k=3 clusters——————————————–

The sub-sampling and clustering approach is a helpful method to evaluate the robustness of the clustering results under various subsets and to obtain insights into the structure of the data. Furthermore, we will take 100 samples from our data set to ensure that the clustering plot doesn’t get too crowded.

set.seed(7)

# Specify the number of rows you want to sample
num_rows <- 100

# Use sample with the specified seed
idx <- sample(1:dim(Hobby_Data2)[1], num_rows)

Hobby_Data3 <- Hobby_Data2[idx, ]

pam.result <- pam(Hobby_Data3,3)
#Show the silhoutee plot of PAM AND clusters
plot(pam.result)

<<<<<<< Updated upstream =======

>>>>>>> Stashed changes

# Extract the clusinfo component
clusinfo <- pam.result$clusinfo

# Calculate the total within-cluster sum of squares
tot_withinss <- sum(clusinfo[, "size"] * clusinfo[, "av_diss"]^2)

# Print the result
print(tot_withinss)

<<<<<<< Updated upstream =======

str(Hobby_Data2)

 num [1:1601, 1:11] 0.973 0.973 0.973 0.973 0.973 ...
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr [1:11] "Olympiad_Participation" "Scholarship" "Fav_sub" "Projects" ...

Data set without ground truth

Hobby_Data2 <- Hobby_proc[, !(colnames(Hobby_proc) %in% c("Predicted Hobby"))]

summary(Hobby_Data2)

 Olympiad_Participation  Scholarship         Fav_sub           Projects         Grasp_pow         Time_sprt         Career_sprt         Act_sprt      
 Min.   :-1.0269        Min.   :-0.8459   Min.   :-1.0586   Min.   :-1.1709   Min.   :-2.4637   Min.   :-1.50901   Min.   :-0.7698   Min.   :-1.1199  
 1st Qu.:-1.0269        1st Qu.:-0.8459   1st Qu.:-1.0586   1st Qu.:-1.1709   1st Qu.:-0.4771   1st Qu.:-0.76702   1st Qu.:-0.7698   1st Qu.:-1.1199  
 Median : 0.9732        Median :-0.8459   Median :-0.1065   Median : 0.8535   Median :-0.4771   Median :-0.02503   Median :-0.7698   Median : 0.8924  
 Mean   : 0.0000        Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.0000  
 3rd Qu.: 0.9732        3rd Qu.: 1.1815   3rd Qu.: 0.8457   3rd Qu.: 0.8535   3rd Qu.: 0.5162   3rd Qu.: 0.71696   3rd Qu.: 1.2981   3rd Qu.: 0.8924  
 Max.   : 0.9732        Max.   : 1.1815   Max.   : 1.7978   Max.   : 0.8535   Max.   : 2.5028   Max.   : 2.20095   Max.   : 1.2981   Max.   : 0.8924  
   Fant_arts          Won_arts          Time_art      
 Min.   :-0.8733   Min.   :-0.8648   Min.   :-0.9748  
 1st Qu.:-0.8733   1st Qu.:-0.8648   1st Qu.:-0.9748  
 Median :-0.8733   Median :-0.8648   Median :-0.1850  
 Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000  
 3rd Qu.: 1.1443   3rd Qu.: 0.4042   3rd Qu.: 0.6048  
 Max.   : 1.1443   Max.   : 1.6733   Max.   : 2.9741  

str(Hobby_Data2)

List of 17612
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
  [list output truncated]

# Assuming 'pam.result' is the result from PAM clustering
Hobby_Data2$cluster <- as.factor(pam.result$clustering)

Warning: Coercing LHS to a list

# Make sure 'cluster' is a factor
Hobby_Data2$cluster <- as.factor(Hobby_Data2$cluster)

# Check the structure of Hobby_Data2
str(Hobby_Data2)

List of 17612
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
 $        : num 0.973
  [list output truncated]

# Create parallel coordinate plot
p <- ggparcoord(
  data = Hobby_Data2,
  columns = c(1:11),  # Assuming there are 11 columns in your data
  groupColumn = "cluster",
  scale = "std"
) + labs(x = "milk constituent", y = "value (in standard-deviation units)", title = "Clustering")

# Convert the ggplot object to plotly
p_plotly <- ggplotly(p)

# Print the plot
print(p_plotly)

NULL

>>>>>>> Stashed changes

The output of the code, displaying a silhouette plot of the PAM clusters, indicates that the clusters are relatively close to each other, with a slight overlap between two clusters. The silhouette plot visually represents how well-defined and separated the clusters are. While the slight overlap suggests that the natural grouping within the dataset may not be entirely distinct, it does not negatively affect the overall quality of the clusters. In fact, the observed overlap might indicate shared characteristics between adjacent clusters, effectively capturing meaningful patterns and groupings that reflect the intricacies of real-world phenomena not confined to strict boundaries.

bCubed

cluster_assignments <- c(pam.result$cluster)
set.seed(7)

# Specify the number of rows you want to sample
num_rows <- 100

# Use sample with the specified seed
idx <- sample(1:dim(Hobby_proc)[1], num_rows)

# Select the sampled rows from Hobby_proc
Hobby_Data4 <- Hobby_proc[idx, ]
ground_truth_labels <- c(Hobby_Data4)

# Create a data frame with cluster assignments and ground truth labels
dataset <- data.frame(cluster = cluster_assignments, label = ground_truth_labels)

# Calculate BCubed precision and recall
calculate_bcubed_metrics <- function(dataset) {
  n <- nrow(dataset)
  precision_sum <- 0 
  recall_sum <- 0
  
   for (i in 1:n) {
    cluster <- dataset$cluster[i] 
    label <- dataset$label[i]
    
    # Count the number of items from the same category in its cluster
    same_category <- sum(dataset$label[dataset$cluster == cluster] == label)   
    
    # Count the number of items in its cluster    
    same_cluster <- sum(dataset$cluster == cluster)
    
    # Count the number of items in its category
    total_same_category <- sum(dataset$label == label)   
    
    # Calculate precision and recall 
    precision_sum <- precision_sum + same_category / same_cluster
    recall_sum <- recall_sum + same_category / total_same_category 
    }
  # End loop 
  
  # Calculate average precision and recall  
  precision <- precision_sum / n
  recall <- recall_sum / n 
  return(list(precision = precision, recall = recall))}

  # Calculate BCubed precision and recall
  metrics <- calculate_bcubed_metrics(dataset)
  precision <- metrics$precision
  recall <- metrics$recall

# Print the results
  cat("BCubed Precision= ", precision, "AND BCubed Recall= ", recall, "\n")

While precision highlights room for better accuracy in identifying similar items, the higher recall indicates the algorithm’s capability to catch a good amount of actual similarities within clusters.

————————————————–group into k=4 clusters————————————————

set.seed(7)

# Specify the number of rows you want to sample
num_rows <- 100

# Use sample with the specified seed
idx <- sample(1:dim(Hobby_Data2)[1], num_rows)

Hobby_Data3 <- Hobby_Data2[idx, ]

pam.result <- pam(Hobby_Data3,4)
#Show the silhoutee plot of PAM AND clusters
plot(pam.result)

# Extract the clusinfo component
clusinfo <- pam.result$clusinfo

# Calculate the total within-cluster sum of squares
tot_withinss <- sum(clusinfo[, "size"] * clusinfo[, "av_diss"]^2)

# Print the result
print(tot_withinss)

The output suggests that the dataset may exhibit a degree of overlap or similarity among observations. The overlapping clusters may indicate challenges in achieving a clear separation among these groups. The placement of one cluster on top of two others implies that the medoid of this cluster might be near points belonging to those two neighboring clusters. This could be due to the nature of the data.

cluster_assignments <- pam.result$clustering

# Add cluster assignments to the original data
Hobby_Data_with_clusters <- cbind(Hobby_Data3, Cluster = factor(cluster_assignments))

# Example: Pair plot for the first four features
pairs(Hobby_Data_with_clusters[, 1:4], col = cluster_assignments)

BCubed

cluster_assignments <- c(pam.result$cluster) 
 
set.seed(7) 
 
# Specify the number of rows you want to sample 
num_rows <- 100 
 
# Use sample with the specified seed 
idx <- sample(1:dim(Hobby_proc)[1], num_rows) 
 
# Select the sampled rows from Hobby_proc 
Hobby_Data4 <- Hobby_proc[idx, ] 

# Create a data frame with cluster assignments and ground truth labels
dataset <- data.frame(cluster = cluster_assignments, label = ground_truth_labels)

# Calculate BCubed precision and recall
calculate_bcubed_metrics <- function(dataset) {
  n <- nrow(dataset)
  precision_sum <- 0
  recall_sum <- 0
 
  for (i in 1:n) {
    cluster <- dataset$cluster[i]
    label <- dataset$label[i]
   
    # Count the number of items from the same category in its cluster
    same_category <- sum(dataset$label[dataset$cluster == cluster] == label)
   
    # Count the number of items in its cluster
    same_cluster <- sum(dataset$cluster == cluster)
   
    # Count the number of items in its category
    total_same_category <- sum(dataset$label == label)
   
    # Calculate precision and recall
    precision_sum <- precision_sum + same_category / same_cluster
    recall_sum <- recall_sum + same_category / total_same_category
  }
  # End loop
 
  # Calculate average precision and recall
  precision <- precision_sum / n
  recall <- recall_sum / n
 
  return(list(precision = precision, recall = recall))
}

# Calculate BCubed precision and recall
metrics <- calculate_bcubed_metrics(dataset)
precision <- metrics$precision
recall <- metrics$recall

# Print the results
cat("BCubed Precision= ", precision, "AND BCubed Recall= ", recall, "\n")

The results indicate challenges in clustering performance. The low precision suggests a significant rate of misclassification, while the relatively low recall indicates that some instances within the same group are missed or incorrectly assigned to other clusters. These results highlight limitations in accurately capturing the data’s underlying structure.

———————————————-group into k=2 clusters——————————————–

set.seed(7)

# Specify the number of rows you want to sample
num_rows <- 100

# Use sample with the specified seed
idx <- sample(1:dim(Hobby_Data2)[1], num_rows)

Hobby_Data3 <- Hobby_Data2[idx, ]

pam.result <- pam(Hobby_Data3,2)
#Show the silhoutee plot of PAM AND clusters
plot(pam.result)

# Extract the clusinfo component
clusinfo <- pam.result$clusinfo

# Calculate the total within-cluster sum of squares
tot_withinss <- sum(clusinfo[, "size"] * clusinfo[, "av_diss"]^2)

# Print the result
print(tot_withinss)

An overlap between clusters implies that there is ambiguity in the assignment of data points to clusters, and the clusters may not be sufficiently distinct. In such cases, it might be needed to reconsider the number of clusters since the goal is to find a balance, but too few clusters result in oversimplification, as indicated by the observed overlap, and it is evident that forming only two clusters may not be sufficient to represent the inherent structure of the dataset.

#BCubed

cluster_assignments <- c(pam.result$cluster) 
 
set.seed(7) 
 
# Specify the number of rows you want to sample 
num_rows <- 100 
 
# Use sample with the specified seed 
idx <- sample(1:dim(Hobby_proc)[1], num_rows) 
 
# Select the sampled rows from Hobby_proc 
Hobby_Data4 <- Hobby_proc[idx, ] 

# Create a data frame with cluster assignments and ground truth labels
dataset <- data.frame(cluster = cluster_assignments, label = ground_truth_labels)

# Calculate BCubed precision and recall
calculate_bcubed_metrics <- function(dataset) {
  n <- nrow(dataset)
  precision_sum <- 0
  recall_sum <- 0
 
  for (i in 1:n) {
    cluster <- dataset$cluster[i]
    label <- dataset$label[i]
   
    # Count the number of items from the same category in its cluster
    same_category <- sum(dataset$label[dataset$cluster == cluster] == label)
   
    # Count the number of items in its cluster
    same_cluster <- sum(dataset$cluster == cluster)
   
    # Count the number of items in its category
    total_same_category <- sum(dataset$label == label)
   
    # Calculate precision and recall
    precision_sum <- precision_sum + same_category / same_cluster
    recall_sum <- recall_sum + same_category / total_same_category
  }
  # End loop
 
  # Calculate average precision and recall
  precision <- precision_sum / n
  recall <- recall_sum / n
 
  return(list(precision = precision, recall = recall))
}

# Calculate BCubed precision and recall
metrics <- calculate_bcubed_metrics(dataset)
precision <- metrics$precision
recall <- metrics$recall

# Print the results
cat("BCubed Precision= ", precision, "AND BCubed Recall= ", recall, "\n")

The relatively high recall could be influenced by the specific choice of two clusters since it is sensitive to the number of clusters. In the context of a two-cluster solution, the recall score reflects how well the algorithm groups data points from the same class into one of the two identified clusters. Recall suggests that a significant portion of data points from the same ground truth class are indeed grouped together in one of the two clusters. However, it’s important to note that the low precision score (0.0432) indicates a lack of homogeneity within the identified clusters, implying that the clusters contain a mix of data points from different ground truth classes.

AS A Summary For clustring Silhouette analysis measures how similar an object is to its own cluster (cohesion) compared to other clusters (separation). The silhouette width ranges from -1 to 1, where a high value indicates that the object is well matched to its own cluster and poorly matched to neighboring clusters. In our project we did clusters for k=3, k=4, and k=2 since its have higher average silhouette then other number.

For k=3, the average silhouette width is 0.22. For k=4, the average silhouette width is 0.19. For k=2, the average silhouette width is 0.21.

A higher average silhouette width generally indicates better-defined clusters. So, in this case, k=3 has the highest average silhouette width.

BCubed is a clustering evaluation metric that considers both precision and recall. Precision measures the accuracy of the positive predictions, while recall measures the coverage of the actual positive instances.

For k=3, BBCubed Precision = 0.0488 BCubed Recall = 0.4932 For k=4,BCubed Precision = 0.0505 BCubed Recall = 0.4101 For k=2, BCubedPrecision = 0.0432 BCubed Recall = 0.6252

These metrics measure how well the clustering aligns with the ground truth. Higher precision indicates fewer false positives, and higher recall indicates fewer false negatives. Here, k=2 has the highest recall (0.6252), but k=3 has a reasonable balance between precision and recall.

In conclusion, k=3 seems to be a reasonable choice. It has a good silhouette width, and its BCubed Precision and Recall values strike a balance.

library(plotly)

Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

Attaching package: ‘plotly’

The following object is masked from ‘package:ggplot2’:

    last_plot

The following object is masked from ‘package:stats’:

    filter

The following object is masked from ‘package:graphics’:

    layout

Findings

	90%/10%	90%/10%	90%/10%	80%/20%	80%/20%	80%/20%	70%/30%	70%/30%	70%/30%
	IG	IG ratio	Gini Index	IG	IG ratio	Gini Index	IG	IG ratio	Gini Index
Accuracy	0.872	0.8944	0.91875	0.905	0.888	0.906	0.893	0.8939	0.911
precision	0.856	0.892	0.91850	0.898	0.881	0.905	0.887	0.890	0.909
sensitiviy	0.856	0.891	0.91927	0.898	0.890	0.909	0.887	0.902	0.912
specificiy	0.919	0.945	0.9578	0.937	0.943	0.952	0.929	0.947	0.954

References

What is the best for our dataset?

since We used the Information Gain, Gini Index, and Gain Ratio as three important metrics in our categorical data classification approach to determine how important certain variables were in predicting hobby categories. The dataset was split into training and testing sets so that different subsets of the data could be used to train classification algorithms. Three metrics were used to evaluate the performance of the model: overall accuracy, recall, and precision.We examined accuracy at several measures of tree selection, Provide us with more accurate results, specifically at the pruning parameters of 0.90, 0.91, and 0.89, in order.The methodical evaluation yielded insightful information on how well each selection measure performed in producing precise predictions within the dataset. high accuracy strongly suggest that, for our dataset, classification is a better methodology than clustering, since the classification give us a good result then clustring.

<<<<<<< Updated upstream ======= >>>>>>> Stashed changes